Transactor/Transactor_08_1985_Transactor_Publishing.d64/hi-res text src

Commodore BASIC | 2023-02-26 | 6KB | 248 lines

100 rem hi-res text maker
110 rem by darren james spruyt
120 rem box 1226
130 rem gravenhurst, ontario
140 rem p0c 1g0
150 rem
160 sys 700
170 .opt oo
180 *=$8000
190 base   =$6000
200 temp   =$02b6
210 tmp1   =$02b7
220 tmp2   =$02b8
230 pntr1  =$02b9
240 cntr1  =$02ba
250 charow =$02bb
260 cntr2  =$02ac
270 cntr3  =$02ad
280 color  =$0335
290 additi =$0334
300 ;
310 ;followin jmp table
320 jmp hion
330 jmp clear
340 jmp hioff
350 ;
360 ;start of code
370 print =*
380 ;
390 ;create base address
400 lda #>base
410 sta $23          ;set high address
420 lda #<base       ;a=lo address
430 ldx $02a7        ;character row
440 beq p1           ;for each
450 p3 clc           ;row
460 adc #$40         ;add to base
470 bcc p2           ;address, 320
480 inc $23          ;or $0140 in hex
490 p2 inc $23       ;
500 dex              ;done
510 bne p3           ;no
520 p1 ldx $02a6     ;column address
530 beq p4           ;for each column
540 p6 clc           ;add 8
550 adc #$08         ;to the base
560 bcc p5           ;address
570 inc $23          ;
580 p5 dex           ;doneprint
590 bne p6           ;no
600 p4 sta $22       ;save lo address
610 ;
620 ;copy char data from rom
630 ;to $02ae
640 sei              ;lockout irq
650 lda $01
660 and #%11111011   ;make d rom
670 sta $01          ;visible
680 lda #$00         ;generate
690 sta $15
700 lda $02ab        ;indirect
710 sta $14
720 asl $14          ;based
730 rol $15
740 asl $14          ;on
750 rol $15
760 asl $14          ;character number
770 rol $15
780 clc              ;times 8
790 lda #$d8
800 adc $15          ;plus $d000
810 sta $15
820 ldy #$07         ;copy character
830 l1 lda ($14),y
840 sta $02ae,y      ;bit patterns
850 dey
860 bpl l1           ;from rom
870 lda $01
880 ora #%00000100
890 sta $01          ;close rom up
900 cli              ;release irq
910 lda #0           ;initialize
920 sta charow       ;char pixel rows
930 sta cntr3        ;screen pixel row
940 z15 lda $02aa
950 sta cntr2        ;y multiple size
960 z13 lda cntr3
970 sta pntr1        ;y val for screen
980 ldx charow       ;current char row
990 ldy #$07         ;break bits
1000 z1 ror $02ae,x   ;into bytes at
1010 bcs z2           ;$033c
1020 lda #$00
1030 .byte $2c
1040 z2 lda #$ff
1050 sta $033c,y
1060 dey              ;done break
1070 bpl z1           ;no
1080 ror $02ae,x      ;finish rotation
1090 lda #0
1100 sta temp         ;set temp
1110 lda #$08
1120 sta cntr1        ;set rotations 8
1130 ldx #$00
1140 z8  ldy $02a9    ;get x multiple
1150 z5 lda $033c,x   ;test bit values
1160 beq z3           ;zero means 0
1170 sec              ;rotate a 1 in
1180 rol temp
1190 jmp z4
1200 z3 clc           ;rotate a 0 in
1210 rol temp
1220 z4 dec cntr1     ;done 8 shifts
1230 beq z6           ;yes - to screen
1240 z7  dey          ;check multiples
1250 bne z5           ;do more
1260 inx              ;check all 8 bits
1270 cpx #$08         ;are done
1280 bne z8           ;no - do more
1290 jmp z9          ;
1300 z6 =*           ;
1310 sty tmp1        ;save y
1320 stx tmp2        ;save x
1330 ldy pntr1       ;get y pntr
1340 lda additi      ;mesh mode
1350 beq z23         ;no
1360 lda ($22),y     ;get prev pattern
1370 z23 ora temp    ;add new pattern
1380 sta ($22),y     ;back to screen
1390 lda #0          ;set temp to zero
1400 sta temp
1410 lda #8          ;set cntr
1420 sta cntr1
1430 lda pntr1       ;add 8 tp pntr1
1440 clc             ;to get
1450 adc #$08        ;to the next
1460 sta pntr1       ;row
1470 ldy tmp1        ;restore x and y
1480 ldx tmp2
1490 jmp z7          ;recurse
1500 z9 inc cntr3    ;count pixel rows
1510 lda cntr3
1520 cmp #$08        ;at eight
1530 bne z10         ;nope
1540 lda #$00
1550 sta cntr3       ;re-set counter
1560 clc
1570 lda $22         ;add 320
1580 adc #$40
1590 bcc z11         ;to the indirect
1600 inc $23
1610 z11 inc $23     ;address ($22)
1620 sta $22
1630 z10 dec cntr2   ;y multiples
1640 beq z12         ;done
1650 jmp z13         ;repeat previos ro
1660 z12  inc charow ;chr  pixel row
1670 lda charow      ;
1680 cmp #$08        ;done all 8 rows
1690 beq z14         ;yes then finished
1700 jmp z15         ;do next row
1710 z14 =*
1720 ;add colour as indicated
1730 lda #$5c        ;build the
1740 sta $15
1750 lda #$00        ;indirect
1760 ldx $02a7
1770 beq j2          ;address
1780 j3 clc
1790 adc #$28        ;via base
1800 bcc j1
1810 inc $15         ;of $5c00
1820 j1 dex
1830 bne j3          ;plus y pos *40
1840 j2 clc
1850 adc $02a6       ;and  x pos
1860 sta $14
1870 bcc j7
1880 inc $15         ;done
1890 j7 =*
1900 ldx $02aa       ;get y size
1910 j6 ldy $02a9    ;get x size
1920 dey
1930 lda color       ;get color val
1940 j4 sta ($14),y  ;put in mem
1950 dey             ;done x
1960 bpl j4          ;no
1970 lda $14         ;add 40
1980 clc
1990 adc #$28        ;to the address
2000 bcc j5
2010 inc $15         ;done
2020 j5 sta $14
2030 dex             ;done y
2040 bne j6          ;no
2050 rts
2060 hion =*
2070 lda $d011
2080 ora #%00100000   ;turn hi-res bit
2090 sta $d011
2100 lda #%01111000
2110 sta $d018        ;set screen/map
2120 lda $dd00
2130 and #%11111100
2140 ora #%00000010
2150 sta $dd00        ;set vic chip
2160 rts              ;addresses
2170 hioff =*
2180 lda $d011
2190 and #%11011111   ;re-set bit map
2200 sta $d011
2210 lda #21
2220 sta $d018        ;reset screenmap
2230 lda $dd00
2240 and #%11111100
2250 ora #%00000011
2260 sta $dd00        ;reset vic chip
2270 rts              ;address
2280 clear ldy #0
2290 lda #>base       ;base address
2300 sta $15          ;into
2310 sty $14          ;($14)
2320 ldx #32          ;do 32 pages
2330 lda #00          ;
2340 t6 sta ($14),y   ;zero memory
2350 dey
2360 bne t6
2370 inc $15
2380 dex              ;doneprint
2390 bne t6           ;no
2400 lda $d021        ;pull old color
2410 and #%00001111   ;from vic chip
2420 sta $02
2430 asl
2440 asl
2450 asl              ;shift to high
2460 asl              ;nybble
2470 ldy #0
2480 ora $02          ;low nybble
2490 j53 sta $5c00,y  ;fill
2500 sta $5d00,y      ;color
2510 sta $5e00,y      ;area
2520 sta $5f00-24,y   ;up
2530 iny
2540 bne j53
2550 rts
2560 .end